perm filename GAME.JMC[206,LSP] blob
sn#544562 filedate 1980-10-25 generic text, type C, neo UTF8
COMMENT ā VALID 00003 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 Game functions valmax,linemax,treemax,rectify,commontail,commonhead tryjmc
C00010 00003 (DEFPROP GAMEXX
C00011 ENDMK
Cā;
;;; Game functions valmax,linemax,treemax,rectify,commontail,commonhead tryjmc
(DEFPROP GAME
(VALMAX
VALMIN
LINEMAX
LINEMIN
TREEMAX
TREEMIN
RECTIFY
COMMONTAIL
COMMONHEAD
TRYJMC)
FNS)
(DEFPROP VALMAX
(LAMBDA(U ALPHA BETA)
(COND ((NULL U) ALPHA)
(T
((LAMBDA(S)
(COND ((NOT (GREATERP S ALPHA))
(VALMAX (CDR U) ALPHA BETA))
((LESSP S BETA) (VALMAX (CDR U) S BETA))
(T BETA)))
(COND ((TER (RECTIFY (CAR U)) ALPHA BETA) (IMVAL (CAR U)))
(T (VALMIN (SUCCESSORS (CAR U)) ALPHA BETA)))))))
EXPR)
(DEFPROP VALMIN
(LAMBDA(U ALPHA BETA)
(COND ((NULL U) BETA)
(T
((LAMBDA(S)
(COND ((NOT (GREATERP S ALPHA)) ALPHA)
((LESSP S BETA) (VALMIN (CDR U) ALPHA S))
(T (VALMIN (CDR U) ALPHA BETA))))
(COND ((TER (RECTIFY (CAR U)) ALPHA BETA) (IMVAL (CAR U)))
(T (VALMAX (SUCCESSORS (CAR U)) ALPHA BETA)))))))
EXPR)
(DEFPROP LINEMAX
(LAMBDA(U LINE ALPHA BETA)
(COND ((NULL U) (CONS ALPHA LINE))
(T
((LAMBDA(S)
(COND ((NOT (GREATERP (CAR S) ALPHA))
(LINEMAX (CDR U) LINE ALPHA BETA))
((LESSP (CAR S) BETA)
(LINEMAX (CDR U)
(CONS (EXT (CAR U)) (CDR S))
(CAR S)
BETA))
(T (CONS BETA LINE))))
(COND ((TER (RECTIFY (CAR U)) ALPHA BETA)
(LIST (IMVAL (CAR U))))
(T
(LINEMIN (SUCCESSORS (CAR U))
(CONS BETA (QUOTE BETA-CUTOFF))
ALPHA
BETA)))))))
EXPR)
(DEFPROP LINEMIN
(LAMBDA(U LINE ALPHA BETA)
(COND ((NULL U) (CONS BETA LINE))
(T
((LAMBDA(S)
(COND ((NOT (GREATERP (CAR S) ALPHA)) (CONS ALPHA LINE))
((LESSP (CAR S) BETA)
(LINEMIN (CDR U)
(CONS (EXT (CAR U)) (CDR S))
ALPHA
(CAR S)))
(T (LINEMIN (CDR U) LINE ALPHA BETA))))
(COND ((TER (RECTIFY (CAR U)) ALPHA BETA)
(LIST (IMVAL (CAR U))))
(T
(LINEMAX (SUCCESSORS (CAR U))
(CONS ALPHA (QUOTE ALPHA-CUTOFF))
ALPHA
BETA)))))))
EXPR)
(DEFPROP TREEMAX
(LAMBDA(U TRMAX TRMIN ALPHA BETA)
(COND
((NULL U) (LIST ALPHA TRMAX TRMIN))
(T
((LAMBDA(S)
(COND
((NOT (GREATERP (CAR S) ALPHA))
(TREEMAX (CDR U)
TRMAX
(CONS (CONS (EXT (CAR U)) (CADDR S)) TRMIN)
ALPHA
BETA))
((LESSP (CAR S) BETA)
(TREEMAX (CDR U)
(CONS (EXT (CAR U)) (CADR S))
(CONS (CONS (EXT (CAR U)) (CADDR S)) TRMIN)
(CAR S)
BETA))
(T (LIST BETA (CONS (EXT (CAR U)) (CADR S)) NIL))))
(COND
((TER (RECTIFY (CAR U)) ALPHA BETA)
((LAMBDA (V) (LIST V (LIST V) (LIST V))) (IMVAL (CAR U))))
(T
(TREEMIN (SUCCESSORS (CAR U))
NIL
(CONS BETA (QUOTE BETA-CUTOFF))
ALPHA
BETA)))))))
EXPR)
(DEFPROP TREEMIN
(LAMBDA(U TRMAX TRMIN ALPHA BETA)
(COND
((NULL U) (LIST BETA TRMAX TRMIN))
(T
((LAMBDA(S)
(COND
((NOT (GREATERP (CAR S) ALPHA))
(LIST ALPHA NIL (CONS (EXT (CAR U)) (CADDR S))))
((LESSP (CAR S) BETA)
(TREEMIN (CDR U)
(CONS (CONS (EXT (CAR U)) (CADR S)) TRMAX)
(CONS (EXT (CAR U)) (CADDR S))
ALPHA
(CAR S)))
(T
(TREEMIN (CDR U)
(CONS (CONS (EXT (CAR U)) (CADR S)) TRMAX)
TRMIN
ALPHA
BETA))))
(COND
((TER (RECTIFY (CAR U)) ALPHA BETA)
((LAMBDA (V) (LIST V (LIST V) (LIST V))) (IMVAL (CAR U))))
(T
(TREEMAX (SUCCESSORS (CAR U))
(CONS ALPHA (QUOTE ALPHA-CUTOFF))
NIL
ALPHA
BETA)))))))
EXPR)
(DEFPROP RECTIFY
(LAMBDA(P)
(PROG (Z Q)
(SETQ Q (COMMONTAIL P P1))
L1 (COND ((EQUAL Q P1) (GO L2)))
(REVERT)
(GO L1)
L2 (SETQ Z (LISTSUBT P P1))
L3 (COND ((NULL Z) (RETURN P)))
(UPDATE (CAR Z))
(SETQ Z (CDR Z))
(GO L3)))
EXPR)
(DEFPROP COMMONTAIL
(LAMBDA (U V) (REVERSE (COMMONHEAD (REVERSE U) (REVERSE V))))
EXPR)
(DEFPROP COMMONHEAD
(LAMBDA(U V)
(COND ((OR (NULL U) (NULL V) (NOT (EQUAL (CAR U) (CAR V)))) NIL)
(T (CONS (CAR U) (COMMONHEAD (CDR U) (CDR V))))))
EXPR)
(DEFUN TRYJMC (MODE WW POS)
(PROG ()
(NEWGAME)
(SETQ W WW)
(MAPC (FUNCTION UPDATE) (REVERSE POS))
(PRINTBOARD)
(PRINT
(COND ((EQ MODE 'VAL)
(COND (W (VALMIN (SUCCESSORS P1) -1000 1000))
(T (VALMAX (SUCCESSORS P1) -1000 1000))))
((EQ MODE 'LINE)
(COND (W (LINEMIN (SUCCESSORS P1) NIL -1000 1000))
(T (LINEMAX (SUCCESSORS P1) NIL -1000 1000))))
((EQ MODE 'TREE)
(COND (W (TREEMIN (SUCCESSORS P1) NIL NIL -1000 1000))
(T (TREEMAX (SUCCESSORS P1) NIL NIL -1000 1000)))) )
) ))
(DEFPROP GAMEXX
(VMX LMX TMX)
FNS)
(DEFPROP VMX
(LAMBDA (P) (RECTIFY P) (COND (W (VALMIN (SUCCESSORS P) -1000 1000)) (T (VALMAX (SUCCESSORS P) -1000 1000))))
EXPR)
(DEFPROP LMX
(LAMBDA(P)
(RECTIFY P)
(COND (W (LINEMIN (SUCCESSORS P) NIL -1000 1000)) (T (LINEMAX (SUCCESSORS P) NIL -1000 1000))))
EXPR)
(DEFPROP TMX
(LAMBDA(P)
(RECTIFY P)
(COND (W (TREEMIN (SUCCESSORS P) NIL NIL -1000 1000)) (T (TREEMAX (SUCCESSORS P) NIL NIL -1000 1000))))
EXPR)